home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / tclmCmd.c < prev    next >
C/C++ Source or Header  |  1993-08-16  |  55KB  |  2,143 lines
  1. /*-
  2.  * Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  3.  *
  4.  * Redistribution and use in source and binary forms, with or without
  5.  * modification, are permitted provided that the following conditions
  6.  * are met:
  7.  * 1. Redistributions of source code must retain the above copyright
  8.  *    notice, this list of conditions and the following disclaimer.
  9.  * 2. Redistributions in binary form must reproduce the above copyright
  10.  *    notice, this list of conditions and the following disclaimer in the
  11.  *    documentation and/or other materials provided with the distribution.
  12.  * 3. All advertising materials mentioning features or use of this software
  13.  *    must display the following acknowledgement:
  14.  *    This product includes software developed by Michael B. Durian.
  15.  * 4. The name of the the Author may be used to endorse or promote 
  16.  *    products derived from this software without specific prior written 
  17.  *    permission.
  18.  *
  19.  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  20.  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  21.  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  22.  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  23.  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  24.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  25.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  26.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  28.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  29.  * SUCH DAMAGE.
  30.  */
  31. /*
  32.  * tclmCmd.c,v 1.14 1993/05/07 17:45:07 durian Exp
  33.  */
  34.  
  35. static char cvsid[] = "tclmCmd.c,v 1.14 1993/05/07 17:45:07 durian Exp";
  36.  
  37. #include "tclInt.h"
  38. #include "tclUnix.h"
  39. #include "patchlevel.h"
  40. #include "mutil.h"
  41. #include "tclm.h"
  42. #ifdef MIDIPLAY
  43. #include "tclmPlay.h"
  44. #endif
  45.  
  46.  
  47. Tcl_HashTable MidiFileHash;
  48. static int mfileId = 0;
  49.  
  50. static char *key_strings[] = {"C flat", "G flat", "D flat", "A flat",
  51.     "E flat", "B flat", "F", "C", "G", "D", "A", "E", "B", "F sharp",
  52.     "C sharp"};
  53. static char *event_list = "channelpressure keypressure \"a meta event\" \
  54. noteoff noteon parameter pitchwheel program sysex";
  55. static char *meta_events = "metachanprefix metacpy metacue metaeot \
  56. metainstname metakey metalyric metamarker metaseqname metaseqnum metaseqspec \
  57. metasmpte metatempo metatext metatime";
  58.  
  59. static int Tclm_ConvertMeta _ANSI_ARGS_((Tcl_Interp *, int, char **,
  60.     unsigned char *, int *));
  61. static int Tclm_ConvertTiming _ANSI_ARGS_((Tcl_Interp *, char *,
  62.     unsigned char *, int *));
  63. static int Tclm_ConvertBytes _ANSI_ARGS_((Tcl_Interp *, char *,
  64.     unsigned char *, int *));
  65. static int Tclm_AddMetaBytes _ANSI_ARGS_((Tcl_Interp *, unsigned char *, int *,
  66.     char *));
  67. static void Tclm_AddMetaString _ANSI_ARGS_((unsigned char *, int *, char *));
  68. static void Tclm_MakeMetaText _ANSI_ARGS_((Tcl_Interp *, unsigned char *));
  69.  
  70. void
  71. Tclm_InitMidi(interp)
  72.     Tcl_Interp *interp;
  73. {
  74.  
  75.     Tcl_CreateCommand(interp, "midiconfig", Tclm_MidiConfig, NULL, NULL);
  76.     Tcl_CreateCommand(interp, "midiread", Tclm_MidiRead, NULL, NULL);
  77.     Tcl_CreateCommand(interp, "midiwrite", Tclm_MidiWrite, NULL, NULL);
  78.     Tcl_CreateCommand(interp, "midimerge", Tclm_MidiMerge, NULL, NULL);
  79.     Tcl_CreateCommand(interp, "midimake", Tclm_MidiMake, NULL, NULL);
  80.     Tcl_CreateCommand(interp, "midifree", Tclm_MidiFree, NULL, NULL);
  81.     Tcl_CreateCommand(interp, "midirewind", Tclm_MidiRewind, NULL, NULL);
  82.  
  83.     Tcl_CreateCommand(interp, "midifixtovar", Tclm_MidiFixToVar, NULL,
  84.         NULL);
  85.     Tcl_CreateCommand(interp, "midivartofix", Tclm_MidiVarToFix, NULL,
  86.         NULL);
  87.     Tcl_CreateCommand(interp, "midiget", Tclm_MidiGet, NULL, NULL);
  88.     Tcl_CreateCommand(interp, "midiput", Tclm_MidiPut, NULL, NULL);
  89.     Tcl_CreateCommand(interp, "miditiming", Tclm_MidiTiming, NULL, NULL);
  90.     Tcl_CreateCommand(interp, "midiplayable", Tclm_MidiPlayable, NULL,
  91.         NULL);
  92.     Tcl_CreateCommand(interp, "tclmversion", Tclm_TclmVersion, NULL, NULL);
  93.     Tcl_InitHashTable(&MidiFileHash, TCL_ONE_WORD_KEYS);
  94. #ifdef MIDIPLAY
  95.     Tclm_InitPlay(interp);
  96. #endif
  97. }
  98.  
  99.  
  100. int
  101. Tclm_MidiConfig(dummy, interp, argc, argv)
  102.     ClientData dummy;
  103.     Tcl_Interp *interp;
  104.     int argc;
  105.     char **argv;
  106. {
  107.     int length;
  108.     int result;
  109.  
  110.     /*
  111.      * argv[0] - midiconfig
  112.      * argv[1] - mfileID
  113.      * argv[2] - format | division | tracks
  114.      * argv[3] - optional arg
  115.      */
  116.     result = TCL_OK;
  117.     if (argc < 3 || argc > 4) {
  118.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  119.             argv[0], "mfileId {format | division | tracks} ?arg?\"",
  120.             (char *)NULL);
  121.         return (TCL_ERROR);
  122.     }
  123.  
  124.     length = strlen(argv[2]);
  125.     switch(argv[2][0]) {
  126.     case 'd':
  127.         if (strncmp(argv[2], "division", length) == 0)
  128.             result = Tclm_Division(interp, argc, argv);
  129.         else {
  130.             Tcl_AppendResult(interp, "bad option, ", argv[2],
  131.                 ", must be one of format, division or tracks",
  132.                 (char *)NULL);
  133.             return (TCL_ERROR);
  134.         }
  135.         break;
  136.     case 'f':
  137.         if (strncmp(argv[2], "format", length) == 0)
  138.             result = Tclm_Format(interp, argc, argv);
  139.         else {
  140.             Tcl_AppendResult(interp, "bad option, ", argv[2],
  141.                 ", must be one of format, division or tracks",
  142.                 (char *)NULL);
  143.             return (TCL_ERROR);
  144.         }
  145.         break;
  146.     case 't':
  147.         if (strncmp(argv[2], "tracks", length) == 0)
  148.             result = Tclm_NumTracks(interp, argc, argv);
  149.         else {
  150.             Tcl_AppendResult(interp, "bad option, ", argv[2],
  151.                 ", must be one of format, division or tracks",
  152.                 (char *)NULL);
  153.             return (TCL_ERROR);
  154.         }
  155.         break;
  156.     default:
  157.         Tcl_AppendResult(interp, "bad option, ", argv[2],
  158.             ", must be one of format, division or tracks",
  159.             (char *)NULL);
  160.         return (TCL_ERROR);
  161.     }
  162.  
  163.     return (result);
  164. }
  165.  
  166. int
  167. Tclm_MidiMake(dummy, interp, argc, argv)
  168.     ClientData dummy;
  169.     Tcl_Interp *interp;
  170.     int argc;
  171.     char **argv;
  172. {
  173.     MIDI_FILE *mfile;
  174.     Tcl_HashEntry *hash_entry;
  175.     int created_hash;
  176.  
  177.     /*
  178.      * argv[0] - midimake
  179.      */
  180.     if (argc != 1) {
  181.         Tcl_AppendResult(interp, "bad # args: should be \"",
  182.             argv[0], "\"", (char *)NULL);
  183.         return (TCL_ERROR);
  184.     }
  185.     if ((mfile = (MIDI_FILE *)malloc(sizeof(MIDI_FILE))) == NULL) {
  186.         Tcl_AppendResult(interp, "Not enough memory for MIDI file",
  187.             (char *)NULL);
  188.         return (TCL_ERROR);
  189.     }
  190.     strncpy(mfile->hchunk.str, "MThd", 4);
  191.     mfile->hchunk.length = 6;
  192.     mfile->hchunk.format = 1;
  193.     mfile->hchunk.division = 120;
  194.     mfile->hchunk.num_trks = 0;
  195.     mfile->tchunks = NULL;
  196.  
  197.     hash_entry = Tcl_CreateHashEntry(&MidiFileHash, (char *)mfileId,
  198.         &created_hash);
  199.     if (!created_hash) {
  200.         Tcl_AppendResult(interp, "Hash bucket for file alread ",
  201.             "exists", (char *)NULL);
  202.         return (TCL_ERROR);
  203.     }
  204.     Tcl_SetHashValue(hash_entry, mfile);
  205.  
  206.     sprintf(interp->result, "mfile%d", mfileId++);
  207.     return (TCL_OK);
  208. }
  209.  
  210. int
  211. Tclm_MidiRead(dummy, interp, argc, argv)
  212.     ClientData dummy;
  213.     Tcl_Interp *interp;
  214.     int argc;
  215.     char **argv;
  216. {
  217.     MIDI_FILE *mfile;
  218.     OpenFile *filePtr;
  219.     Tcl_HashEntry *hash_entry;
  220.     int created_hash;
  221.     int fd;
  222.     int i;
  223.     int result;
  224.     char num_str[20];
  225.  
  226.     /*
  227.      * argv[0] - midiread
  228.      * argv[1] - open file descriptor
  229.      */
  230.     if (argc != 2) {
  231.         Tcl_AppendResult(interp, "bad # args: should be \"",
  232.             argv[0], " fileId\"", (char *)NULL);
  233.         return (TCL_ERROR);
  234.     }
  235.     if ((result = TclGetOpenFile(interp, argv[1], &filePtr)) != TCL_OK)
  236.         return (result);
  237.  
  238.     fd = fileno(filePtr->f);
  239.     if ((mfile = (MIDI_FILE *)malloc(sizeof(MIDI_FILE))) == NULL) {
  240.         Tcl_AppendResult(interp, "Not enough memory for MIDI file",
  241.             (char *)NULL);
  242.         return (TCL_ERROR);
  243.     }
  244.     if (!read_header_chunk(fd, &mfile->hchunk)) {
  245.         if (MidiEof)
  246.             Tcl_AppendResult(interp, "EOF");
  247.         else
  248.             Tcl_AppendResult(interp,
  249.                 "Couldn't read header chunk\n", MidiError,
  250.                 (char *)NULL);
  251.         return (TCL_ERROR);
  252.     }
  253.     if ((mfile->tchunks = (TCHUNK *)malloc(mfile->hchunk.num_trks *
  254.         sizeof(TCHUNK))) == NULL) {
  255.         Tcl_AppendResult(interp, "Not enough memory for track ",
  256.             "chunks", (char *)NULL);
  257.         return (TCL_ERROR);
  258.     }
  259.  
  260.     for (i = 0;  i < mfile->hchunk.num_trks; i++) {
  261.         if (!read_track_chunk(fd, &(mfile->tchunks[i]))) {
  262.             sprintf(num_str, "%d", i);
  263.             Tcl_AppendResult(interp, "Couldn't read track ",
  264.                 "number ",  num_str, "\n", MidiError,
  265.                 (char *)NULL);
  266.             return (TCL_ERROR);
  267.         }
  268.     }
  269.     hash_entry = Tcl_CreateHashEntry(&MidiFileHash, (char *)mfileId,
  270.         &created_hash);
  271.     if (!created_hash) {
  272.         Tcl_AppendResult(interp, "Hash bucket for file alread ",
  273.             "exists", (char *)NULL);
  274.         return (TCL_ERROR);
  275.     }
  276.     Tcl_SetHashValue(hash_entry, mfile);
  277.  
  278.     sprintf(interp->result, "mfile%d", mfileId++);
  279.     return (TCL_OK);
  280. }
  281.  
  282. int
  283. Tclm_MidiWrite(dummy, interp, argc, argv)
  284.     ClientData dummy;
  285.     Tcl_Interp *interp;
  286.     int argc;
  287.     char **argv;
  288. {
  289.     MIDI_FILE *mfile;
  290.     OpenFile *filePtr;
  291.     int fd;
  292.     int i;
  293.     int result;
  294.  
  295.     /*
  296.      * argv[0] - midiwrite
  297.      * argv[1] - mfileId
  298.      * argv[2] - fileId
  299.      */
  300.     if (argc != 3) {
  301.         Tcl_AppendResult(interp, "bad # args: shoudl be \"",
  302.             argv[0], " mfileId fileId\"", (char *)NULL);
  303.         return (TCL_ERROR);
  304.     }
  305.     if ((result = TclGetOpenFile(interp, argv[2], &filePtr)) != TCL_OK)
  306.         return (result);
  307.  
  308.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  309.         return (result);
  310.  
  311.     fd = fileno(filePtr->f);
  312.  
  313.     if (!write_header_chunk(fd, &mfile->hchunk)) {
  314.         Tcl_AppendResult(interp, "Couldn't write header chunk\n",
  315.             MidiError, (char *)NULL);
  316.         return (TCL_ERROR);
  317.     }
  318.     for (i = 0; i < mfile->hchunk.num_trks; i++) {
  319.         if (!write_track_chunk(fd, &(mfile->tchunks[i]))) {
  320.             sprintf(interp->result,
  321.                 "Coudln't write track chunk %d\n%s", i,
  322.                 MidiError);
  323.             return (TCL_ERROR);
  324.         }
  325.     }
  326.     return (TCL_OK);
  327. }
  328.  
  329. int
  330. Tclm_MidiMerge(dummy, interp, argc, argv)
  331.     ClientData dummy;
  332.     Tcl_Interp *interp;
  333.     int argc;
  334.     char **argv;
  335. {
  336.     char **strs;
  337.     char **substrs;
  338.     MIDI_FILE *outmfile;
  339.     MIDI_FILE **inmfile;
  340.     TCHUNK **intrack;
  341.     TCHUNK *outtrack;
  342.     int *tscalar;
  343.     char *chk_ptr;
  344.     int delta;
  345.     int endtime;
  346.     int i;
  347.     int ind;
  348.     int numin;
  349.     int num_strs;
  350.     int num_substrs;
  351.     int result;
  352.  
  353.     /*
  354.      * argv[0] - midimerge
  355.      * argv[1] - {outmfile outtrack}
  356.      * argv[2] - {{inmfile intrack tscalar} {inmfile intrack tscalar} ...}
  357.      * argv[3] - delta
  358.      */
  359.     if (argc != 4) {
  360.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  361.             argv[0], " {outmfile outtrack} {{inmfile intrack} ",
  362.             "{inmfile intrack} ...} delta", (char *)NULL);
  363.         return (TCL_ERROR);
  364.     }
  365.  
  366.     /* parse output fields */
  367.     if ((result = Tcl_SplitList(interp, argv[1], &num_strs, &strs)) !=
  368.         TCL_OK)
  369.         return (result);
  370.  
  371.     if (num_strs != 2) {
  372.         Tcl_AppendResult(interp, "bad track designation: ",
  373.             argv[1], (char *)NULL);
  374.         return (TCL_ERROR);
  375.     }
  376.  
  377.     if ((result = Tclm_GetMFile(interp, strs[0], &outmfile)) != TCL_OK)
  378.         return (result);
  379.  
  380.     ind = (int)strtol(strs[1], &chk_ptr, 0);
  381.     if (chk_ptr == strs[1] || ind < 0 || ind > outmfile->hchunk.num_trks) {
  382.         Tcl_AppendResult(interp, "bad outtrack value: ", strs[1],
  383.             (char *)NULL);
  384.         return (TCL_ERROR);
  385.     }
  386.     free((char *)strs);
  387.  
  388.     outtrack = &outmfile->tchunks[ind];
  389.  
  390.     /* now parse input strs */
  391.     if ((result = Tcl_SplitList(interp, argv[2], &num_strs, &strs)) !=
  392.         TCL_OK)
  393.         return (result);
  394.  
  395.     numin = num_strs;
  396.     if ((inmfile = (MIDI_FILE **)malloc(sizeof(MIDI_FILE *) * numin))
  397.         == NULL) {
  398.         Tcl_AppendResult(interp, "Not enough memory for infiles",
  399.             (char *)NULL);
  400.         free((char *)strs);
  401.         return (TCL_ERROR);
  402.     }
  403.     if ((tscalar = (int *)malloc(sizeof(int) * numin)) == NULL) {
  404.         Tcl_AppendResult(interp, "Not enough memory for tscalars",
  405.             (char *)NULL);
  406.         free((char *)strs);
  407.         free((char *)inmfile);
  408.         return (TCL_ERROR);
  409.     }
  410.     if ((intrack = (TCHUNK **)malloc(sizeof(TCHUNK *) * numin)) == NULL) {
  411.         Tcl_AppendResult(interp, "Not enough memory for intracks",
  412.             (char *)NULL);
  413.         free((char *)strs);
  414.         free((char *)inmfile);
  415.         free((char *)tscalar);
  416.         return (TCL_ERROR);
  417.     }
  418.  
  419.     for (i = 0; i < numin; i++) {
  420.         /* parse each input pair */
  421.         if ((result = Tcl_SplitList(interp, strs[i], &num_substrs,
  422.             &substrs)) != TCL_OK) {
  423.             free((char *)strs);
  424.             free((char *)inmfile);
  425.             free((char *)tscalar);
  426.             free((char *)intrack);
  427.             return (result);
  428.         }
  429.         if (num_substrs != 3) {
  430.             Tcl_AppendResult(interp, "bad track designation: ",
  431.                 strs[i], (char *)NULL);
  432.             free((char *)strs);
  433.             free((char *)inmfile);
  434.             free((char *)tscalar);
  435.             free((char *)intrack);
  436.             return (TCL_ERROR);
  437.         }
  438.         if ((result = Tclm_GetMFile(interp, substrs[0], &inmfile[i]))
  439.             != TCL_OK) {
  440.             free((char *)strs);
  441.             free((char *)inmfile);
  442.             free((char *)tscalar);
  443.             free((char *)intrack);
  444.             return (result);
  445.         }
  446.         ind = (int)strtol(substrs[1], &chk_ptr, 0);
  447.         if (chk_ptr == substrs[1] || ind < 0 ||
  448.             ind > inmfile[i]->hchunk.num_trks) {
  449.             Tcl_AppendResult(interp, "bad outtrack value: ",
  450.                 substrs[1], (char *)NULL);
  451.             free((char *)strs);
  452.             free((char *)inmfile);
  453.             free((char *)tscalar);
  454.             free((char *)intrack);
  455.             free((char *)substrs);
  456.             return (TCL_ERROR);
  457.         }
  458.         intrack[i] = &inmfile[i]->tchunks[ind];
  459.  
  460.         tscalar[i] = (int)strtol(substrs[2], &chk_ptr, 0);
  461.         if (chk_ptr == substrs[2]) {
  462.             Tcl_AppendResult(interp, "bad tscalar value: ",
  463.                 substrs[2], (char *)NULL);
  464.             free((char *)strs);
  465.             free((char *)inmfile);
  466.             free((char *)tscalar);
  467.             free((char *)intrack);
  468.             free((char *)substrs);
  469.             return (TCL_ERROR);
  470.         }
  471.  
  472.         free((char *)substrs);
  473.     }
  474.     free((char *)strs);
  475.  
  476.     delta = (int)strtol(argv[3], &chk_ptr, 0);
  477.     if (chk_ptr == argv[3]) {
  478.         Tcl_AppendResult(interp, "bad delta value: ", argv[3],
  479.             (char *)NULL);
  480.         free((char *)inmfile);
  481.         free((char *)tscalar);
  482.         free((char *)intrack);
  483.         return (TCL_ERROR);
  484.     }
  485.  
  486.     if ((endtime = merge_tracks(outtrack, intrack, tscalar, numin, delta))
  487.         == -1) {
  488.         Tcl_AppendResult(interp, "Couldn't merge files\n",
  489.             MidiError, (char *)NULL);
  490.         free((char *)inmfile);
  491.         free((char *)tscalar);
  492.         free((char *)intrack);
  493.         return (TCL_ERROR);
  494.     }
  495.  
  496.     sprintf(interp->result, "%d", endtime);
  497.     free((char *)inmfile);
  498.     free((char *)tscalar);
  499.     free((char *)intrack);
  500.     return (TCL_OK);
  501. }
  502.  
  503. int
  504. Tclm_MidiFree(dummy, interp, argc, argv)
  505.     ClientData dummy;
  506.     Tcl_Interp *interp;
  507.     int argc;
  508.     char **argv;
  509. {
  510.     MIDI_FILE *mfile;
  511.     int mfileId;
  512.     int result;
  513.  
  514.     /*
  515.      * argv[0] - midifree
  516.      * argv[1] - mfileId
  517.      */
  518.     if (argc != 2) {
  519.         Tcl_AppendResult(interp, "bad # args: should be \"",
  520.             argv[0], " mfileId\"", (char *)NULL);
  521.         return (TCL_ERROR);
  522.     }
  523.  
  524.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  525.         return (result);
  526.  
  527.     mfileId = (int)strtol(argv[1] + 5, NULL, 0);
  528.     Tcl_DeleteHashEntry(Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId));
  529.  
  530.     free(mfile->tchunks);
  531.     free(mfile);
  532.     return (TCL_OK);
  533. }
  534.  
  535. int
  536. Tclm_GetMFile(interp, FileId, mfile)
  537.     Tcl_Interp *interp;
  538.     char *FileId;
  539.     MIDI_FILE **mfile;
  540. {
  541.     Tcl_HashEntry *hash_entry;
  542.     char *chk_ptr;
  543.     int mfileId;
  544.  
  545.     if (strncmp(FileId, "mfile", 5) != 0) {
  546.         Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
  547.             FileId, "\"", (char *)NULL);
  548.         return (TCL_ERROR);
  549.     }
  550.  
  551.     mfileId = (int)strtol(FileId + 5, &chk_ptr, 0);
  552.     if (chk_ptr == FileId + 5) {
  553.         Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
  554.             FileId, "\"", (char *)NULL);
  555.         return (TCL_ERROR);
  556.     }
  557.     if ((hash_entry = Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId))
  558.         == NULL) {
  559.         Tcl_AppendResult(interp, FileId, " doesn't exist",
  560.             (char *)NULL);
  561.         return (TCL_ERROR);
  562.     }
  563.     *mfile = (MIDI_FILE *)Tcl_GetHashValue(hash_entry);
  564.     return (TCL_OK);
  565. }
  566.  
  567. int
  568. Tclm_SetMFile(interp, FileId, mfile)
  569.     Tcl_Interp *interp;
  570.     char *FileId;
  571.     MIDI_FILE *mfile;
  572. {
  573.     Tcl_HashEntry *hash_entry;
  574.     char *chk_ptr;
  575.     int mfileId;
  576.  
  577.     if (strncmp(FileId, "mfile", 5) != 0) {
  578.         Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
  579.             FileId, "\"", (char *)NULL);
  580.         return (TCL_ERROR);
  581.     }
  582.  
  583.     mfileId = (int)strtol(FileId + 5, &chk_ptr, 0);
  584.     if (chk_ptr == FileId + 5) {
  585.         Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
  586.             FileId, "\"", (char *)NULL);
  587.         return (TCL_ERROR);
  588.     }
  589.     if ((hash_entry = Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId))
  590.         == NULL) {
  591.         Tcl_AppendResult(interp, FileId, " doesn't exist",
  592.             (char *)NULL);
  593.         return (TCL_ERROR);
  594.     }
  595.     Tcl_SetHashValue(hash_entry, (char *)mfile);
  596.     return (TCL_OK);
  597. }
  598.  
  599. int
  600. Tclm_NumTracks(interp, argc, argv)
  601.     Tcl_Interp *interp;
  602.     int argc;
  603.     char **argv;
  604. {
  605.     MIDI_FILE *mfile;
  606.     char *chk_ptr;
  607.     int i;
  608.     int result;
  609.     int num_trks;
  610.  
  611.     /*
  612.      * argv[0] - midiconfig
  613.      * argv[1] - mfileId
  614.      * argv[2] - tracks
  615.      * argv[3] - optional number of tracks
  616.      */
  617.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  618.         return (result);
  619.  
  620.     if (argc == 3)
  621.         sprintf(interp->result, "%d", mfile->hchunk.num_trks);
  622.     else {
  623.         num_trks = (int)strtol(argv[3], &chk_ptr, 0);
  624.         if (chk_ptr == argv[3]) {
  625.             Tcl_AppendResult(interp, "Bad number of tracks ",
  626.                 argv[3], (char *)NULL);
  627.             return (TCL_ERROR);
  628.         }
  629.         if (mfile->hchunk.format == 0 && num_trks > 1) {
  630.             Tcl_AppendResult(interp, "Format 0 files can only ",
  631.                 "have zero or one tracks, not ", argv[3],
  632.                 (char *)NULL);
  633.             return (TCL_ERROR);
  634.         }
  635.         if (mfile->tchunks == NULL) {
  636.             if (num_trks != 0) {
  637.                 if ((mfile->tchunks = (TCHUNK *)malloc(
  638.                     sizeof(TCHUNK) * num_trks)) == NULL) {
  639.                     Tcl_AppendResult(interp,
  640.                         "Not enough memory for ", argv[3],
  641.                         " tracks", (char *)NULL);
  642.                 }
  643.             }
  644.         } else {
  645.             if (num_trks == 0) {
  646.                 free((char *)mfile->tchunks);
  647.                 mfile->tchunks = NULL;
  648.             } else {
  649.                 if ((mfile->tchunks = (TCHUNK *)realloc(
  650.                     mfile->tchunks, sizeof(TCHUNK) * num_trks))
  651.                     == NULL) {
  652.                     Tcl_AppendResult(interp,
  653.                         "Not enough memory for ", argv[3],
  654.                         " tracks", (char *)NULL);
  655.                 }
  656.             }
  657.         }
  658.  
  659.         for (i = mfile->hchunk.num_trks; i < num_trks; i++)
  660.             init_track(&mfile->tchunks[i]);
  661.  
  662.         mfile->hchunk.num_trks = num_trks;
  663.         if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
  664.             TCL_OK)
  665.             return (result);
  666.     }
  667.     return (TCL_OK);
  668. }
  669.  
  670. int
  671. Tclm_Format(interp, argc, argv)
  672.     Tcl_Interp *interp;
  673.     int argc;
  674.     char **argv;
  675. {
  676.     MIDI_FILE *mfile;
  677.     char *chk_ptr;
  678.     int result;
  679.     int format;
  680.  
  681.     /*
  682.      * argv[0] - midiconfig
  683.      * argv[1] - mfileId
  684.      * argv[2] - format
  685.      * argv[3] - optional arg
  686.      */
  687.  
  688.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  689.         return (result);
  690.  
  691.     if (argc == 3)
  692.         sprintf(interp->result, "%d", mfile->hchunk.format);
  693.     else {
  694.         format = (int)strtol(argv[3], &chk_ptr, 0);
  695.         if (chk_ptr == argv[3] || format < 0 || format > 2) {
  696.             Tcl_AppendResult(interp, "Bad format",
  697.                 argv[2], (char *)NULL);
  698.             return (TCL_ERROR);
  699.         }
  700.         if (format == 0 && mfile->hchunk.num_trks > 1) {
  701.             Tcl_AppendResult(interp, argv[1], " has too ",
  702.                 "many tracks to be format 0", (char *)NULL);
  703.             return (TCL_ERROR);
  704.         }
  705.         mfile->hchunk.format = format;
  706.         if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
  707.             TCL_OK)
  708.             return (result);
  709.     }
  710.     return (TCL_OK);
  711. }
  712.  
  713. int
  714. Tclm_Division(interp, argc, argv)
  715.     Tcl_Interp *interp;
  716.     int argc;
  717.     char **argv;
  718. {
  719.     MIDI_FILE *mfile;
  720.     char *chk_ptr;
  721.     int division;
  722.     int result;
  723.  
  724.     /*
  725.      * argv[0] - midiconfig
  726.      * argv[1] - mfileId
  727.      * argv[2] - division
  728.      * argv[3] - optional arg
  729.      */
  730.  
  731.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  732.         return (result);
  733.  
  734.     if (argc == 3)
  735.         sprintf(interp->result, "%d", mfile->hchunk.division);
  736.     else {
  737.         division = (int)strtol(argv[3], &chk_ptr, 0);
  738.         if (chk_ptr == argv[3]) {
  739.             Tcl_AppendResult(interp, "bad division value ",
  740.                 argv[3], (char *)NULL);
  741.             return (TCL_ERROR);
  742.         }
  743.         mfile->hchunk.division = division;
  744.         if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
  745.             TCL_OK)
  746.             return (result);
  747.     }
  748.     return (TCL_OK);
  749. }
  750.  
  751. int
  752. Tclm_MidiGet(foo, interp, argc, argv)
  753.     ClientData foo;
  754.     Tcl_Interp *interp;
  755.     int argc;
  756.     char **argv;
  757. {
  758.     long timing;
  759.     char *chk_ptr;
  760.     unsigned char *event_ptr;
  761.     MIDI_FILE *mfile;
  762.     Tcl_Interp *temp_interp;
  763.     int channel;
  764.     int delta;
  765.     int denom;
  766.     int data_length;
  767.     int event_size;
  768.     int i;
  769.     int normal_type;
  770.     int result;
  771.     int track_num;
  772.     EVENT_TYPE event_type;
  773.     char dummy[MAX_EVENT_SIZE];
  774.     unsigned char event[MAX_EVENT_SIZE];
  775.     unsigned char running_state;
  776.  
  777.     /*
  778.      * argv[0] - midiget
  779.      * argv[1] - mfileId
  780.      * argv[2] - track number
  781.      */
  782.  
  783.     if (argc != 3) {
  784.         Tcl_AppendResult(interp, "bad # args: should be \"",
  785.             argv[0], " mfileId track_num\"", (char *)NULL);
  786.         return (TCL_ERROR);
  787.     }
  788.  
  789.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  790.         return (result);
  791.  
  792.     track_num = (int)strtol(argv[2], &chk_ptr, 0);
  793.     if (chk_ptr == argv[2] || track_num < 0 ||
  794.         track_num > mfile->hchunk.num_trks - 1) {
  795.         Tcl_AppendResult(interp, "Bad track number ", argv[2],
  796.             (char *)NULL);
  797.         return (TCL_ERROR);
  798.     }
  799.     if ((event_size = get_smf_event(&(mfile->tchunks[track_num]), event,
  800.         &event_type)) == -1) {
  801.         Tcl_AppendResult(interp, "Couldn't get event from ", argv[1],
  802.             " track ", argv[2], "\n", MidiError, (char *)NULL);
  803.         return (TCL_ERROR);
  804.     }
  805.     if (event_size == 0) {
  806.         Tcl_AppendResult(interp, "EOT", (char *)NULL);
  807.         return (TCL_OK);
  808.     }
  809.  
  810.     /* get timing and skip over it */
  811.     event_ptr = event;
  812.     timing = var2fix(event_ptr, &delta);
  813.     sprintf(dummy, "%ld ", timing);
  814.     Tcl_AppendResult(interp, dummy, (char *)NULL);
  815.     event_ptr += delta;
  816.     event_size -= delta;
  817.  
  818.     switch(event_type) {
  819.     case NORMAL:
  820.         if (event_ptr[0] & 0x80) {
  821.             running_state = event_ptr[0];
  822.             event_ptr++;
  823.             event_size--;
  824.         } else {
  825.             running_state =
  826.                 get_running_state(&mfile->tchunks[track_num]);
  827.         }
  828.         normal_type = running_state & 0xf0;
  829.         channel = running_state & 0x0f;
  830.         switch(normal_type) {
  831.         case 0x80:
  832.             sprintf(dummy, "noteoff %d 0x%02x 0x%02x",
  833.                 channel, event_ptr[0], event_ptr[1]);
  834.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  835.             break;
  836.         case 0x90:
  837.             sprintf(dummy, "noteon %d 0x%02x 0x%02x",
  838.                 channel, event_ptr[0], event_ptr[1]);
  839.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  840.             break;
  841.         case 0xa0:
  842.             sprintf(dummy, "keypressure %d 0x%02x 0x%02x",
  843.                 channel, event_ptr[0], event_ptr[1]);
  844.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  845.             break;
  846.         case 0xb0:
  847.             sprintf(dummy, "parameter %d 0x%02x 0x%02x",
  848.                 channel, event_ptr[0], event_ptr[1]);
  849.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  850.             break;
  851.         case 0xc0:
  852.             sprintf(dummy, "program %d 0x%02x",
  853.                 channel, event_ptr[0]);
  854.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  855.             break;
  856.         case 0xd0:
  857.             sprintf(dummy, "channelpressure %d 0x%02x",
  858.                 channel, event_ptr[0]);
  859.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  860.             break;
  861.         case 0xe0:
  862.             sprintf(dummy, "pitchwheel %d 0x%04x",
  863.                 channel, ((event_ptr[1] << 7) & 0x3f80) |
  864.                 event_ptr[0]);
  865.             Tcl_AppendResult(interp, dummy, (char *)NULL);
  866.             break;
  867.         }
  868.         break;
  869.     case SYSEX:
  870.         Tcl_AppendResult(interp, "sysex ", (char *)NULL);
  871.         if (*event_ptr == 0xf7)
  872.             Tcl_AppendResult(interp, "cont ", (char *)NULL);
  873.         event_ptr++;
  874.         event_size--;
  875.         temp_interp = Tcl_CreateInterp();
  876.         data_length = var2fix(event_ptr, &delta);
  877.         for (i = 0; i < data_length; i++) {
  878.             sprintf(dummy, "0x%02x", event_ptr[delta + i]);
  879.             Tcl_AppendElement(temp_interp, dummy, 0);
  880.         }
  881.         Tcl_AppendElement(interp, temp_interp->result, 0);
  882.         Tcl_DeleteInterp(temp_interp);
  883.         break;
  884.     case METASEQNUM:
  885.         sprintf(dummy, "metaseqnum %d",
  886.             ((event_ptr[3] << 8) & 0xff00) | (event_ptr[4] & 0xff));
  887.         Tcl_AppendResult(interp, dummy, (char *)NULL);
  888.         break;
  889.     case METATEXT:
  890.         Tcl_AppendResult(interp, "metatext ", (char *)NULL);
  891.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  892.         break;
  893.     case METACPY:
  894.         Tcl_AppendResult(interp, "metacpy ", (char *)NULL);
  895.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  896.         break;
  897.     case METASEQNAME:
  898.         Tcl_AppendResult(interp, "metaseqname ", (char *)NULL);
  899.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  900.         break;
  901.     case METAINSTNAME:
  902.         Tcl_AppendResult(interp, "metainstname ", (char *)NULL);
  903.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  904.         break;
  905.     case METALYRIC:
  906.         Tcl_AppendResult(interp, "metalyric ", (char *)NULL);
  907.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  908.         break;
  909.     case METAMARKER:
  910.         Tcl_AppendResult(interp, "metamarker ", (char *)NULL);
  911.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  912.         break;
  913.     case METACUE:
  914.         Tcl_AppendResult(interp, "metacue ", (char *)NULL);
  915.         Tclm_MakeMetaText(interp, &event_ptr[2]);
  916.         break;
  917.     case METACHANPREFIX:
  918.         temp_interp = Tcl_CreateInterp();
  919.         data_length = var2fix(&event_ptr[2], &delta);
  920.         for (i = 0; i < data_length; i++) {
  921.             sprintf(dummy, "0x%02x", event_ptr[2 + delta + i]);
  922.             Tcl_AppendElement(temp_interp, dummy, 0);
  923.         }
  924.         Tcl_AppendResult(interp, "metachanprefix {",
  925.             temp_interp->result, "}", (char *)NULL);
  926.         Tcl_DeleteInterp(temp_interp);
  927.         break;
  928.     case METAEOT:
  929.         Tcl_AppendResult(interp, "metaeot", (char *)NULL);
  930.         break;
  931.     case METATEMPO:
  932.         sprintf(dummy, "metatempo %d", 60000000 /
  933.             (event_ptr[3] * 0x10000 + event_ptr[4] * 0x100 +
  934.             event_ptr[5]));
  935.         Tcl_AppendResult(interp, dummy, (char *)NULL);
  936.         break;
  937.     case METASMPTE:
  938.         sprintf(dummy, "metasmpte %d %d %d %d %d", event_ptr[3],
  939.             event_ptr[4], event_ptr[5], event_ptr[6], event_ptr[7]);
  940.         Tcl_AppendResult(interp, dummy, (char *)NULL);
  941.         break;
  942.     case METATIME:
  943.         denom = 1;
  944.         for (i = 0; i < event_ptr[4]; i++)
  945.             denom *= 2;
  946.         sprintf(dummy, "metatime %d %d %d %d", event_ptr[3], denom,
  947.             event_ptr[5], event_ptr[6]);
  948.         Tcl_AppendResult(interp, dummy, (char *)NULL);
  949.         break;
  950.     case METAKEY:
  951.         Tcl_AppendResult(interp, "metakey \"",
  952.             key_strings[(int)event_ptr[3] + 7], "\" ",
  953.             (char *)NULL);
  954.         if (event_ptr[4] == 0)
  955.             Tcl_AppendResult(interp, "major", (char *)NULL);
  956.         else
  957.             Tcl_AppendResult(interp, "minor", (char *)NULL);
  958.         break;
  959.     case METASEQSPEC:
  960.         Tcl_AppendResult(interp, "metaseqspec", (char *)NULL);
  961.         break;
  962.     }
  963.  
  964.     return (TCL_OK);
  965. }
  966.  
  967. static void
  968. Tclm_MakeMetaText(interp, event)
  969.     Tcl_Interp *interp;
  970.     unsigned char *event;
  971. {
  972.     int data_length;
  973.     int delta;
  974.     int i;
  975.     char dummy[MAX_EVENT_SIZE];
  976.  
  977.     data_length = var2fix(event, &delta);
  978.     for (i = 0; i < data_length; i++)
  979.         dummy[i] = event[delta + i];
  980.     dummy[i] = '\0';
  981.     Tcl_AppendResult(interp, "\"", dummy, "\"", (char *)NULL);
  982. }
  983.  
  984. static int
  985. Tclm_ConvertTiming(interp, str, timing, timing_length)
  986.     Tcl_Interp *interp;
  987.     char *str;
  988.     unsigned char *timing;
  989.     int *timing_length;
  990. {
  991.     long time_long;
  992.     int i;
  993.     int num_bytes;
  994.     int result;
  995.     char *chk_ptr;
  996.     char **bytes_str;
  997.  
  998.     if ((result = Tcl_SplitList(interp, str, &num_bytes, &bytes_str)) !=
  999.         TCL_OK)
  1000.         return (result);
  1001.  
  1002.     if (num_bytes == 1) {
  1003.         time_long = strtol(bytes_str[0], &chk_ptr, 0);
  1004.         if (bytes_str[0] == chk_ptr) {
  1005.             Tcl_AppendResult(interp, "Bad timing value ",
  1006.                 bytes_str[0], (char *)NULL);
  1007.             free((char *)bytes_str);
  1008.             return (TCL_ERROR);
  1009.         }
  1010.         *timing_length = fix2var(time_long, timing);
  1011.     } else {
  1012.  
  1013.         for (i = 0; i < num_bytes; i++) {
  1014.             timing[i] = (unsigned char)strtol(bytes_str[i],
  1015.                 &chk_ptr, 0);
  1016.             if (chk_ptr == bytes_str[i]) {
  1017.                 Tcl_AppendResult(interp, "Bad timing data ",
  1018.                     bytes_str[i], (char *)NULL);
  1019.                 free((char *)bytes_str);
  1020.                 return (TCL_ERROR);
  1021.             }
  1022.         }
  1023.         *timing_length = num_bytes;
  1024.     }
  1025.     free((char *)bytes_str);
  1026.     return (TCL_OK);
  1027. }
  1028.  
  1029. static int
  1030. Tclm_ConvertBytes(interp, str, bytes, num_bytes)
  1031.     Tcl_Interp *interp;
  1032.     char *str;
  1033.     unsigned char *bytes;
  1034.     int *num_bytes;
  1035. {
  1036.     int i;
  1037.     int result;
  1038.     char *chk_ptr;
  1039.     char **bytes_str;
  1040.  
  1041.     if ((result = Tcl_SplitList(interp, str, num_bytes, &bytes_str)) !=
  1042.         TCL_OK)
  1043.         return (result);
  1044.  
  1045.     for (i = 0; i < *num_bytes; i++) {
  1046.         *bytes++ = (unsigned char)strtol(bytes_str[i], &chk_ptr, 0);
  1047.         if (chk_ptr == bytes_str[i]) {
  1048.             Tcl_AppendResult(interp, "Bad event data ",
  1049.                 bytes_str[i], (char *)NULL);
  1050.             free((char *)bytes_str);
  1051.             return (TCL_ERROR);
  1052.         }
  1053.     }
  1054.     free((char *)bytes_str);
  1055.     return (TCL_OK);
  1056. }
  1057.  
  1058. int
  1059. Tclm_MidiPut(dummy, interp, argc, argv)
  1060.     ClientData dummy;
  1061.     Tcl_Interp *interp;
  1062.     int argc;
  1063.     char **argv;
  1064. {
  1065.     char *chk_ptr;
  1066.     char *event_name;
  1067.     char *event_ptr;
  1068.     MIDI_FILE *mfile;
  1069.     int bad_event;
  1070.     int i;
  1071.     int length;
  1072.     int num_bytes;
  1073.     int result;
  1074.     int timing_length;
  1075.     int track_num;
  1076.     unsigned char timing[4];
  1077.     unsigned char event[MAX_EVENT_SIZE];
  1078.  
  1079.     /*
  1080.      * argv[0] - midiput
  1081.      * argv[1] - mfileId
  1082.      * argv[2] - track number
  1083.      * argv[3] - timing
  1084.      * argv[4] - event name
  1085.      * argv[5] - event specific data
  1086.      * argv[6] - 
  1087.          * etc.
  1088.      */
  1089.  
  1090.     if (argc < 5) {
  1091.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  1092.             "midiput mfileId track timing eventname ?args ...?\"",
  1093.             (char *)NULL);
  1094.         return (TCL_ERROR);
  1095.     }
  1096.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  1097.         return (result);
  1098.  
  1099.     track_num = (int)strtol(argv[2], &chk_ptr, 0);
  1100.     if (chk_ptr == argv[2] || track_num < 0 ||
  1101.         track_num > mfile->hchunk.num_trks - 1) {
  1102.         Tcl_AppendResult(interp, "Bad track number ", argv[2],
  1103.             (char *)NULL);
  1104.         return (TCL_ERROR);
  1105.     }
  1106.  
  1107.     if ((result = Tclm_ConvertTiming(interp, argv[3], timing,
  1108.         &timing_length)) != TCL_OK)
  1109.         return (result);
  1110.  
  1111.     for (i = 0; i < timing_length; i++)
  1112.         event[i] = timing[i];
  1113.     num_bytes = timing_length;
  1114.     /* do different things depending on the event type */
  1115.     event_name = argv[4];
  1116.     length = strlen(event_name);
  1117.  
  1118.     bad_event = 0;
  1119.  
  1120.     switch(event_name[0]) {
  1121.     case 'c':
  1122.         if (strncmp(event_name, "channelpressure", length) != 0)
  1123.             bad_event = 1;
  1124.         else {
  1125.             /*
  1126.              * argv[5] - channel
  1127.              * argv[6] - pressure
  1128.              */
  1129.             unsigned char channel;
  1130.             unsigned char pressure;
  1131.  
  1132.             if (argc != 7) {
  1133.                 Tcl_AppendResult(interp, "wrong # args: ",
  1134.                     "should be \"midiput mfileId track ",
  1135.                     "timing channelpressure channel ",
  1136.                     "pressure\"", (char *)NULL);
  1137.                 return (TCL_ERROR);
  1138.             }
  1139.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1140.             if (chk_ptr == argv[5] || channel & 0x80) {
  1141.                 Tcl_AppendResult(interp, "bad channel ",
  1142.                     argv[5], (char *)NULL);
  1143.                 return (TCL_ERROR);
  1144.             }
  1145.             pressure = (unsigned char)strtol(argv[6], &chk_ptr, 0);
  1146.             if (chk_ptr == argv[6] || pressure & 0x80) {
  1147.                 Tcl_AppendResult(interp, "bad pressure ",
  1148.                     argv[6], (char *)NULL);
  1149.                 return (TCL_ERROR);
  1150.             }
  1151.  
  1152.             event[num_bytes++] = 0xd0 + channel;
  1153.             event[num_bytes++] = pressure;
  1154.         }
  1155.         break;
  1156.     case 'k':
  1157.         if (strncmp(event_name, "keypressure", length) != 0)
  1158.             bad_event = 1;
  1159.         else {
  1160.             /*
  1161.              * argv[5] - channel
  1162.              * argv[6] - pitch
  1163.              * argv[7] - pressure
  1164.              */
  1165.             unsigned char channel;
  1166.             unsigned char pitch;
  1167.             unsigned char pressure;
  1168.  
  1169.             if (argc != 8) {
  1170.                 Tcl_AppendResult(interp, "wrong # args: ",
  1171.                     "should be \"midiput mfileId track ",
  1172.                     "timing keypressure channel ",
  1173.                     "pitch pressure\"", (char *)NULL);
  1174.                 return (TCL_ERROR);
  1175.             }
  1176.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1177.             if (chk_ptr == argv[5] || channel & 0x80) {
  1178.                 Tcl_AppendResult(interp, "bad channel ",
  1179.                     argv[5], (char *)NULL);
  1180.                 return (TCL_ERROR);
  1181.             }
  1182.             pitch = (unsigned char)strtol(argv[6], &chk_ptr, 0);
  1183.             if (chk_ptr == argv[6] || pitch & 0x80) {
  1184.                 Tcl_AppendResult(interp, "bad pitch ",
  1185.                     argv[6], (char *)NULL);
  1186.                 return (TCL_ERROR);
  1187.             }
  1188.             pressure = (unsigned char)strtol(argv[7], &chk_ptr, 0);
  1189.             if (chk_ptr == argv[7] || pressure & 0x80) {
  1190.                 Tcl_AppendResult(interp, "bad pressure ",
  1191.                     argv[7], (char *)NULL);
  1192.                 return (TCL_ERROR);
  1193.             }
  1194.  
  1195.             event[num_bytes++] = 0xa0 + channel;
  1196.             event[num_bytes++] = pitch;
  1197.             event[num_bytes++] = pressure;
  1198.         }
  1199.         break;
  1200.     case 'm':
  1201.         /* META stuff */
  1202.         if ((result = Tclm_ConvertMeta(interp, argc - 4, argv + 4,
  1203.             event, &num_bytes)) != TCL_OK)
  1204.             return (result);
  1205.         break;
  1206.     case 'n':
  1207.         if (strncmp(event_name, "noteoff", length) == 0 ||
  1208.             strncmp(event_name, "noteon", length) == 0) {
  1209.             /*
  1210.              * argv[5] - channel
  1211.              * argv[6] - pitch
  1212.              * argv[7] - velocity
  1213.              */
  1214.             unsigned char channel;
  1215.             unsigned char pitch;
  1216.             unsigned char velocity;
  1217.  
  1218.             if (event_name[5] == 'n') {
  1219.                 if (argc != 8) {
  1220.                     Tcl_AppendResult(interp, "wrong #",
  1221.                         "args: should be \"midiput ",
  1222.                         "mfileId track timing noteon ",
  1223.                         "channel pitch velocity\"",
  1224.                         (char *)NULL);
  1225.                     return (TCL_ERROR);
  1226.                 }
  1227.             } else {
  1228.                 if (argc != 7 && argc != 8) {
  1229.                     Tcl_AppendResult(interp, "wrong #",
  1230.                         "args: should be \"midiput ",
  1231.                         "mfileId track timing noteoff ",
  1232.                         "channel pitch ?velocity?\"",
  1233.                         (char *)NULL);
  1234.                     return (TCL_ERROR);
  1235.                 }
  1236.             }
  1237.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1238.             if (chk_ptr == argv[5] || channel & 0x80) {
  1239.                 Tcl_AppendResult(interp, "bad channel ",
  1240.                     argv[5], (char *)NULL);
  1241.                 return (TCL_ERROR);
  1242.             }
  1243.             pitch = (unsigned char)strtol(argv[6], &chk_ptr, 0);
  1244.             if (chk_ptr == argv[6] || pitch & 0x80) {
  1245.                 Tcl_AppendResult(interp, "bad pitch ",
  1246.                     argv[6], (char *)NULL);
  1247.                 return (TCL_ERROR);
  1248.             }
  1249.             if (argc == 8) {
  1250.                 velocity = (unsigned char)strtol(argv[7],
  1251.                     &chk_ptr, 0);
  1252.                 if (chk_ptr == argv[7] || velocity & 0x80) {
  1253.                     Tcl_AppendResult(interp, "bad ",
  1254.                         "velocity ", argv[7],
  1255.                         (char *)NULL);
  1256.                     return (TCL_ERROR);
  1257.                 }
  1258.             } else {
  1259.                 velocity = 0;
  1260.             }
  1261.  
  1262.             /*
  1263.              * if noteoff velocity is zero use noteon
  1264.              * This will make better use of running state
  1265.              */
  1266.             if (event_name[5] == 'f' && velocity != 0)
  1267.                 event[num_bytes++] = 0x80 + channel;
  1268.             else
  1269.                 event[num_bytes++] = 0x90 + channel;
  1270.             event[num_bytes++] = pitch;
  1271.             event[num_bytes++] = velocity;
  1272.         } else
  1273.             bad_event = 1;
  1274.         break;
  1275.     case 'p':
  1276.         if (strncmp(event_name, "parameter", length) == 0) {
  1277.             /*
  1278.              * argv[5] - channel
  1279.              * argv[6] - param
  1280.              * argv[7] - setting
  1281.              */
  1282.             unsigned char channel;
  1283.             unsigned char param;
  1284.             unsigned char setting;
  1285.  
  1286.             if (argc != 8) {
  1287.                 Tcl_AppendResult(interp, "wrong # args: ",
  1288.                     "should be \"midiput mfileId track ",
  1289.                     "timing parameter channel ",
  1290.                     "param setting\"", (char *)NULL);
  1291.                 return (TCL_ERROR);
  1292.             }
  1293.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1294.             if (chk_ptr == argv[5] || channel & 0x80) {
  1295.                 Tcl_AppendResult(interp, "bad channel ",
  1296.                     argv[5], (char *)NULL);
  1297.                 return (TCL_ERROR);
  1298.             }
  1299.             param = (unsigned char)strtol(argv[6], &chk_ptr, 0);
  1300.             if (chk_ptr == argv[6] || param & 0x80) {
  1301.                 Tcl_AppendResult(interp, "bad parameter ",
  1302.                     argv[6], (char *)NULL);
  1303.                 return (TCL_ERROR);
  1304.             }
  1305.             setting = (unsigned char)strtol(argv[7], &chk_ptr, 0);
  1306.             if (chk_ptr == argv[7] || setting & 0x80) {
  1307.                 Tcl_AppendResult(interp, "bad setting ",
  1308.                     argv[7], (char *)NULL);
  1309.                 return (TCL_ERROR);
  1310.             }
  1311.  
  1312.             event[num_bytes++] = 0xb0 + channel;
  1313.             event[num_bytes++] = param;
  1314.             event[num_bytes++] = setting;
  1315.         } else if (strncmp(event_name, "pitchwheel", length) == 0) {
  1316.             /*
  1317.              * argv[5] - channel
  1318.              * argv[6] - value
  1319.              */
  1320.             int value;
  1321.             unsigned char channel;
  1322.  
  1323.             if (argc != 7) {
  1324.                 Tcl_AppendResult(interp, "wrong # args: ",
  1325.                     "should be \"midiput mfileId track ",
  1326.                     "timing pitchwheel channel value\"",
  1327.                     (char *)NULL);
  1328.                 return (TCL_ERROR);
  1329.             }
  1330.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1331.             if (chk_ptr == argv[5] || channel & 0x80) {
  1332.                 Tcl_AppendResult(interp, "bad channel ",
  1333.                     argv[5], (char *)NULL);
  1334.                 return (TCL_ERROR);
  1335.             }
  1336.             value = (int)strtol(argv[6], &chk_ptr, 0);
  1337.             if (chk_ptr == argv[6]) {
  1338.                 Tcl_AppendResult(interp, "bad wheel value ",
  1339.                     argv[6], (char *)NULL);
  1340.                 return (TCL_ERROR);
  1341.             }
  1342.  
  1343.             event[num_bytes++] = 0xe0 + channel;
  1344.             event[num_bytes++] = value & 0x7f;
  1345.             event[num_bytes++] = (value >> 7) & 0x7f;
  1346.         } else if (strncmp(event_name, "program", length) == 0) {
  1347.             /*
  1348.              * argv[5] - channel
  1349.              * argv[6] - program
  1350.              */
  1351.             unsigned char channel;
  1352.             unsigned char program;
  1353.  
  1354.             if (argc != 7) {
  1355.                 Tcl_AppendResult(interp, "wrong # args: ",
  1356.                     "should be \"midiput mfileId track ",
  1357.                     "timing program channel program\"",
  1358.                     (char *)NULL);
  1359.                 return (TCL_ERROR);
  1360.             }
  1361.             channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
  1362.             if (chk_ptr == argv[5] || channel & 0x80) {
  1363.                 Tcl_AppendResult(interp, "bad channel ",
  1364.                     argv[5], (char *)NULL);
  1365.                 return (TCL_ERROR);
  1366.             }
  1367.             program = (unsigned char)strtol(argv[6], &chk_ptr, 0);
  1368.             if (chk_ptr == argv[6] || program & 0x80) {
  1369.                 Tcl_AppendResult(interp, "bad program ",
  1370.                     argv[6], (char *)NULL);
  1371.                 return (TCL_ERROR);
  1372.             }
  1373.  
  1374.             event[num_bytes++] = 0xc0 + channel;
  1375.             event[num_bytes++] = program;
  1376.         } else
  1377.             bad_event = 1;
  1378.         break;
  1379.     case 's':
  1380.         /* SYSEX */
  1381.         /*
  1382.          * argv[5] - ?cont? or sysex bytes
  1383.          * argv[6] - ?sysex bytes?
  1384.          */
  1385.  
  1386.         if (strncmp(event_name, "sysex", length) != 0)
  1387.             bad_event = 1;
  1388.         else {
  1389.             if (argc != 6 && argc != 7) {
  1390.                 Tcl_AppendResult(interp, "wrong # args: ",
  1391.                     "should be \"midiput mfileId track ",
  1392.                     "timing sysex ?cont? data\"", (char *)NULL);
  1393.                 return (TCL_ERROR);
  1394.             }
  1395.             if (strcmp(argv[5], "cont") == 0) {
  1396.                 event[num_bytes++] = 0xf7;
  1397.                 event_ptr = argv[6];
  1398.             } else {
  1399.                 event[num_bytes++] = 0xf0;
  1400.                 event_ptr = argv[5];
  1401.             }
  1402.             if ((result = Tclm_AddMetaBytes(interp, event,
  1403.                 &num_bytes, event_ptr)) != TCL_OK)
  1404.                 return (result);
  1405.         }
  1406.         break;
  1407.     }
  1408.  
  1409.     if (bad_event) {
  1410.         Tcl_AppendResult(interp, "Bad event.  Must be one of (",
  1411.             event_list, ")", (char *)NULL);
  1412.         return(TCL_ERROR);
  1413.     }
  1414.  
  1415.     if (!put_smf_event(&(mfile->tchunks[track_num]), event, num_bytes)) {
  1416.         Tcl_AppendResult(interp, "Couldn't put event\n",
  1417.             MidiError, (char *)NULL);
  1418.         return (TCL_ERROR);
  1419.     }
  1420.  
  1421.     return (TCL_OK);
  1422. }
  1423.  
  1424. static int
  1425. Tclm_ConvertMeta(interp, argc, argv, event, num_bytes)
  1426.     Tcl_Interp *interp;
  1427.     int argc;
  1428.     char **argv;
  1429.     unsigned char *event;
  1430.     int *num_bytes;
  1431. {
  1432.     char *chk_ptr;
  1433.     char *event_name;
  1434.     int bad_meta_event;
  1435.     int i;
  1436.     int length;
  1437.     int result;
  1438.     
  1439.  
  1440.     /*
  1441.      * argv[0] - metablah
  1442.      * argv[1] - args
  1443.      */
  1444.     event_name = argv[0];
  1445.     if (strncmp(event_name, "meta", 4) != 0) {
  1446.         Tcl_AppendResult(interp, "bad event type ", argv[0],
  1447.             (char *)NULL);
  1448.         return (TCL_ERROR);
  1449.     }
  1450.     event_name += 4;
  1451.  
  1452.     /* all meta events start with 0xff */
  1453.     event[(*num_bytes)++] = 0xff;
  1454.  
  1455.     length = strlen(event_name);
  1456.     bad_meta_event = 0;
  1457.     switch (event_name[0]) {
  1458.     case 'c':
  1459.         if (strncmp(event_name, "chanprefix", length) == 0) {
  1460.             /*
  1461.              * argv[1] - bytes
  1462.              */
  1463.             if (argc != 2) {
  1464.                 Tcl_AppendResult(interp, "wrong # args: ",
  1465.                     "should be: \"midiput mfileId track ",
  1466.                     "timing metachanprefix data\"",
  1467.                     (char *)NULL);
  1468.                 return (TCL_ERROR);
  1469.             }
  1470.             event[(*num_bytes)++] = 0x20;
  1471.             if ((result = Tclm_AddMetaBytes(interp, event,
  1472.                 num_bytes, argv[1])) != TCL_OK)
  1473.                 return (result);
  1474.         } else if (strncmp(event_name, "cpy", length) == 0) {
  1475.             /*
  1476.              * argv[1] - copyright string
  1477.              */
  1478.             if (argc != 2) {
  1479.                 Tcl_AppendResult(interp, "wrong # args: ",
  1480.                     "should be: \"midiput mfileId track ",
  1481.                     "timing metacpy copyright\"",
  1482.                     (char *)NULL);
  1483.                 return (TCL_ERROR);
  1484.             }
  1485.             event[(*num_bytes)++] = 0x02;
  1486.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1487.         } else if (strncmp(event_name, "cue", length) == 0) {
  1488.             /*
  1489.              * argv[1] - cue string
  1490.              */
  1491.             if (argc != 2) {
  1492.                 Tcl_AppendResult(interp, "wrong # args: ",
  1493.                     "should be: \"midiput mfileId track ",
  1494.                     "timing metacue cue\"",
  1495.                     (char *)NULL);
  1496.                 return (TCL_ERROR);
  1497.             }
  1498.             event[(*num_bytes)++] = 0x07;
  1499.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1500.         } else
  1501.             bad_meta_event = 1;
  1502.         break;
  1503.     case 'e':
  1504.         if (strncmp(event_name, "eot", length) != 0)
  1505.             bad_meta_event = 1;
  1506.         else {
  1507.             if (argc != 1) {
  1508.                 Tcl_AppendResult(interp, "wrong # args: ",
  1509.                     "should be: \"midiput mfileId track ",
  1510.                     "timing metaeot\"",
  1511.                     (char *)NULL);
  1512.                 return (TCL_ERROR);
  1513.             }
  1514.             event[(*num_bytes)++] = 0x2f;
  1515.             event[(*num_bytes)++] = 0x00;
  1516.         }
  1517.         break;
  1518.     case 'i':
  1519.         if (strncmp(event_name, "instname", length) != 0)
  1520.             bad_meta_event = 1;
  1521.         else {
  1522.             /*
  1523.              * argv[1] - instrument string
  1524.              */
  1525.             if (argc != 2) {
  1526.                 Tcl_AppendResult(interp, "wrong # args: ",
  1527.                     "should be: \"midiput mfileId track ",
  1528.                     "timing metainstname instrument\"",
  1529.                     (char *)NULL);
  1530.                 return (TCL_ERROR);
  1531.             }
  1532.             event[(*num_bytes)++] = 0x04;
  1533.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1534.         }
  1535.         break;
  1536.     case 'k':
  1537.         if (strncmp(event_name, "key", length) != 0)
  1538.             bad_meta_event = 1;
  1539.         else {
  1540.             int bad_key;
  1541.  
  1542.             /*
  1543.              * argv[1] - key name
  1544.              * argv[2] - key class
  1545.              */
  1546.             if (argc != 3) {
  1547.                 Tcl_AppendResult(interp, "wrong # args: ",
  1548.                     "should be: \"midiput mfileId track ",
  1549.                     "timing metakey key class\"",
  1550.                     (char *)NULL);
  1551.                 return (TCL_ERROR);
  1552.             }
  1553.             event[(*num_bytes)++] = 0x59;
  1554.             event[(*num_bytes)++] = 2;
  1555.             bad_key = 0;
  1556.             switch (argv[1][0]) {
  1557.             case 'A':
  1558.                 if (strcmp(argv[1], "A") == 0)
  1559.                     event[(*num_bytes)++] = 3;
  1560.                 else if (strcmp(argv[1], "A flat") == 0)
  1561.                     event[(*num_bytes)++] =
  1562.                         (unsigned char)-4;
  1563.                 else
  1564.                     bad_key = 1;
  1565.                 break;
  1566.             case 'B':
  1567.                 if (strcmp(argv[1], "B") == 0)
  1568.                     event[(*num_bytes)++] = 5;
  1569.                 else if (strcmp(argv[1], "B flat") == 0)
  1570.                     event[(*num_bytes)++] =
  1571.                         (unsigned char)-2;
  1572.                 else
  1573.                     bad_key = 1;
  1574.                 break;
  1575.             case 'C':
  1576.                 if (strcmp(argv[1], "C") == 0)
  1577.                     event[(*num_bytes)++] = 0;
  1578.                 else if (strcmp(argv[1], "C flat") == 0)
  1579.                     event[(*num_bytes)++] =
  1580.                         (unsigned char)-7;
  1581.                 else if (strcmp(argv[1], "C sharp") == 0)
  1582.                     event[(*num_bytes)++] = 7;
  1583.                 else
  1584.                     bad_key = 1;
  1585.                 break;
  1586.             case 'D':
  1587.                 if (strcmp(argv[1], "D") == 0)
  1588.                     event[(*num_bytes)++] = 2;
  1589.                 else if (strcmp(argv[1], "D flat") == 0)
  1590.                     event[(*num_bytes)++] =
  1591.                         (unsigned char)-5;
  1592.                 else
  1593.                     bad_key = 1;
  1594.                 break;
  1595.             case 'E':
  1596.                 if (strcmp(argv[1], "E") == 0)
  1597.                     event[(*num_bytes)++] = 4;
  1598.                 else if (strcmp(argv[1], "E flat") == 0)
  1599.                     event[(*num_bytes)++] =
  1600.                         (unsigned char)-3;
  1601.                 else
  1602.                     bad_key = 1;
  1603.                 break;
  1604.             case 'F':
  1605.                 if (strcmp(argv[1], "F") == 0)
  1606.                     event[(*num_bytes)++] =
  1607.                         (unsigned char)-1;
  1608.                 else if (strcmp(argv[1], "F sharp") == 0)
  1609.                     event[(*num_bytes)++] = 6;
  1610.                 else
  1611.                     bad_key = 1;
  1612.                 break;
  1613.             case 'G':
  1614.                 if (strcmp(argv[1], "G") == 0)
  1615.                     event[(*num_bytes)++] = 1;
  1616.                 else if (strcmp(argv[1], "G flat") == 0)
  1617.                     event[(*num_bytes)++] =
  1618.                         (unsigned char)-6;
  1619.                 else
  1620.                     bad_key = 1;
  1621.                 break;
  1622.             default:
  1623.                 bad_key = 1;
  1624.             }
  1625.             if (bad_key) {
  1626.                 Tcl_AppendResult(interp, "Bad key.  Must ",
  1627.                     "be one of: ", (char *)NULL);
  1628.                 for (i = 0; i < sizeof(key_strings) /
  1629.                     sizeof(key_strings[0]); i++)
  1630.                     Tcl_AppendResult(interp, "\"",
  1631.                         key_strings[i], "\" ",
  1632.                         (char *)NULL);
  1633.                 return (TCL_ERROR);
  1634.             }
  1635.             if (strcmp(argv[2], "major") == 0)
  1636.                 event[(*num_bytes)++] = 0;
  1637.             else if (strcmp(argv[2], "minor") == 0)
  1638.                 event[(*num_bytes)++] = 1;
  1639.             else {
  1640.                 Tcl_AppendResult(interp, "Bad key class.  ",
  1641.                     "Must be one of: \"major\" \"minor\"",
  1642.                     (char *)NULL);
  1643.                 return (TCL_ERROR);
  1644.             }
  1645.         }
  1646.         break;
  1647.     case 'l':
  1648.         if (strncmp(event_name, "lyric", length) != 0)
  1649.             bad_meta_event = 1;
  1650.         else {
  1651.             /*
  1652.              * argv[1] - lyric string
  1653.              */
  1654.             if (argc != 2) {
  1655.                 Tcl_AppendResult(interp, "wrong # args: ",
  1656.                     "should be: \"midiput mfileId track ",
  1657.                     "timing metalyric lyric\"",
  1658.                     (char *)NULL);
  1659.                 return (TCL_ERROR);
  1660.             }
  1661.             event[(*num_bytes)++] = 0x05;
  1662.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1663.         }
  1664.         break;
  1665.     case 'm':
  1666.         if (strncmp(event_name, "marker", length) != 0)
  1667.             bad_meta_event = 1;
  1668.         else {
  1669.             /*
  1670.              * argv[1] - marker string
  1671.              */
  1672.             if (argc != 2) {
  1673.                 Tcl_AppendResult(interp, "wrong # args: ",
  1674.                     "should be: \"midiput mfileId track ",
  1675.                     "timing metachanprefix marker\"",
  1676.                     (char *)NULL);
  1677.                 return (TCL_ERROR);
  1678.             }
  1679.             event[(*num_bytes)++] = 0x06;
  1680.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1681.         }
  1682.         break;
  1683.     case 's':
  1684.         if (strncmp(event_name, "seqname", length) == 0) {
  1685.             /*
  1686.              * argv[1] - sequence name string
  1687.              */
  1688.             if (argc != 2) {
  1689.                 Tcl_AppendResult(interp, "wrong # args: ",
  1690.                     "should be: \"midiput mfileId track ",
  1691.                     "timing metaseqname sequencename\"",
  1692.                     (char *)NULL);
  1693.                 return (TCL_ERROR);
  1694.             }
  1695.             event[(*num_bytes)++] = 0x03;
  1696.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1697.         } else if (strncmp(event_name, "seqnum", length) == 0) {
  1698.             int number;
  1699.  
  1700.             /*
  1701.              * argv[1] - sequence number
  1702.              */
  1703.             if (argc != 2) {
  1704.                 Tcl_AppendResult(interp, "wrong # args: ",
  1705.                     "should be: \"midiput mfileId track ",
  1706.                     "timing metaseqnum sequencenumber\"",
  1707.                     (char *)NULL);
  1708.                 return (TCL_ERROR);
  1709.             }
  1710.             event[(*num_bytes)++] = 0x00;
  1711.             event[(*num_bytes)++] = 0x02;
  1712.             number = (int)strtol(argv[1], &chk_ptr, 0);
  1713.             if (argv[1] == chk_ptr) {
  1714.                 Tcl_AppendResult(interp, "Bad sequence number ",
  1715.                     argv[1], (char *)NULL);
  1716.                 return (TCL_ERROR);
  1717.             }
  1718.             event[(*num_bytes)++] = (number >> 8) & 0xff;
  1719.             event[(*num_bytes)++] = number & 0xff;
  1720.         } else if (strncmp(event_name, "seqspec", length) == 0) {
  1721.             Tcl_AppendResult(interp, "META event seqspec not ",
  1722.                 "currently implemented (don't know form)",
  1723.                 (char *)NULL);
  1724.             return (TCL_ERROR);
  1725.         } else if (strncmp(event_name, "smpte", length) == 0) {
  1726.             /*
  1727.              * argv[1] - hour
  1728.              * argv[2] - minute
  1729.              * argv[3] - second
  1730.              * argv[4] - frame
  1731.              * argv[5] - fractional frame
  1732.              */
  1733.             if (argc != 6) {
  1734.                 Tcl_AppendResult(interp, "wrong # args: ",
  1735.                     "should be: \"midiput mfileId track ",
  1736.                     "timing metasmpte hour minute second",
  1737.                     "frame fractionalframe\"",
  1738.                     (char *)NULL);
  1739.                 return (TCL_ERROR);
  1740.             }
  1741.             event[(*num_bytes)++] = 0x54;
  1742.             event[(*num_bytes)++] = 5;
  1743.             event[(*num_bytes)++] = (unsigned char)strtol(argv[1],
  1744.                 &chk_ptr, 0);
  1745.             if (argv[1] == chk_ptr) {
  1746.                 Tcl_AppendResult(interp, "Bad SMPTE hour: ",
  1747.                     argv[1], (char *)NULL);
  1748.                 return (TCL_ERROR);
  1749.             }
  1750.             event[(*num_bytes)++] = (unsigned char)strtol(argv[2],
  1751.                 &chk_ptr, 0);
  1752.             if (argv[2] == chk_ptr) {
  1753.                 Tcl_AppendResult(interp, "Bad SMPTE minute: ",
  1754.                     argv[2], (char *)NULL);
  1755.                 return (TCL_ERROR);
  1756.             }
  1757.             event[(*num_bytes)++] = (unsigned char)strtol(argv[3],
  1758.                 &chk_ptr, 0);
  1759.             if (argv[3] == chk_ptr) {
  1760.                 Tcl_AppendResult(interp, "Bad SMPTE second: ",
  1761.                     argv[3], (char *)NULL);
  1762.                 return (TCL_ERROR);
  1763.             }
  1764.             event[(*num_bytes)++] = (unsigned char)strtol(argv[4],
  1765.                 &chk_ptr, 0);
  1766.             if (argv[4] == chk_ptr) {
  1767.                 Tcl_AppendResult(interp, "Bad SMPTE frame: ",
  1768.                     argv[4], (char *)NULL);
  1769.                 return (TCL_ERROR);
  1770.             }
  1771.             event[(*num_bytes)++] = (unsigned char)strtol(argv[5],
  1772.                 &chk_ptr, 0);
  1773.             if (argv[5] == chk_ptr) {
  1774.                 Tcl_AppendResult(interp, "Bad SMPTE ",
  1775.                     "fractional frame: ", argv[5],
  1776.                     (char *)NULL);
  1777.                 return (TCL_ERROR);
  1778.             }
  1779.         } else
  1780.             bad_meta_event = 1;
  1781.         break;
  1782.     case 't':
  1783.         if (strncmp(event_name, "tempo", length) == 0) {
  1784.             long tempo;
  1785.             int is_bpm;
  1786.             int tempo_length;
  1787.             char tempo_str[20];
  1788.  
  1789.             /*
  1790.              * argv[1] - usec/beat or beat/min
  1791.              */
  1792.             if (argc != 2) {
  1793.                 Tcl_AppendResult(interp, "wrong # args: ",
  1794.                     "should be: \"midiput mfileId track ",
  1795.                     "timing metachanprefix tempo\"",
  1796.                     (char *)NULL);
  1797.                 return (TCL_ERROR);
  1798.             }
  1799.             event[(*num_bytes)++] = 0x51;
  1800.             event[(*num_bytes)++] = 3;
  1801.             strcpy(tempo_str, argv[1]);
  1802.             tempo_length = strlen(tempo_str);
  1803.             if (tempo_str[tempo_length - 1] != 'u')
  1804.                 is_bpm = 1;
  1805.             else {
  1806.                 /* in usec/beat */
  1807.                 tempo_str[tempo_length - 1] = '\0';
  1808.                 is_bpm = 0;
  1809.             }
  1810.             tempo = strtol(tempo_str, &chk_ptr, 0);
  1811.             if (tempo_str == chk_ptr) {
  1812.                 Tcl_AppendResult(interp, "Bad tempo value: ",
  1813.                     argv[1], (char *)NULL);
  1814.                 return (TCL_ERROR);
  1815.             }
  1816.             if (is_bpm)
  1817.                 tempo = 60000000 / tempo;
  1818.             event[(*num_bytes)++] = tempo / 0x10000;
  1819.             tempo %= 0x10000;
  1820.             event[(*num_bytes)++] = tempo / 0x100;
  1821.             tempo %= 0x100;
  1822.             event[(*num_bytes)++] = tempo;
  1823.         } else if (strncmp(event_name, "text", length) == 0) {
  1824.             /*
  1825.              * argv[1] - text string
  1826.              */
  1827.             if (argc != 2) {
  1828.                 Tcl_AppendResult(interp, "wrong # args: ",
  1829.                     "should be: \"midiput mfileId track ",
  1830.                     "timing metatext text\"",
  1831.                     (char *)NULL);
  1832.                 return (TCL_ERROR);
  1833.             }
  1834.             event[(*num_bytes)++] = 0x01;
  1835.             Tclm_AddMetaString(event, num_bytes, argv[1]);
  1836.         } else if (strncmp(event_name, "time", length) == 0) {
  1837.             int denominator;
  1838.             int pow;
  1839.  
  1840.             /* 
  1841.              * argv[1] - numerator
  1842.              * argv[2] - denominator (in - powers of 2)
  1843.              * argv[3] - clocks / met. beat
  1844.              * argv[4] - 32nd notes / quarter notes
  1845.              */
  1846.             if (argc != 5) {
  1847.                 Tcl_AppendResult(interp, "wrong # args: ",
  1848.                     "should be: \"midiput mfileId track ",
  1849.                     "timing metatime numerator denominator",
  1850.                     "clockspermet 32ndsperquarter\"",
  1851.                     (char *)NULL);
  1852.                 return (TCL_ERROR);
  1853.             }
  1854.             event[(*num_bytes)++] = 0x58;
  1855.             event[(*num_bytes)++] = 4;
  1856.             event[(*num_bytes)++] = (unsigned char)strtol(argv[1],
  1857.                 &chk_ptr, 0);
  1858.             if (chk_ptr == argv[1]) {
  1859.                 Tcl_AppendResult(interp, "Bad numerator: ",
  1860.                     argv[1], (char *)NULL);
  1861.                 return (TCL_ERROR);
  1862.             }
  1863.             denominator = (unsigned char)strtol(argv[2],
  1864.                 &chk_ptr, 0);
  1865.             if (chk_ptr == argv[2]) {
  1866.                 Tcl_AppendResult(interp, "Bad denominator: ",
  1867.                     argv[2], (char *)NULL);
  1868.                 return (TCL_ERROR);
  1869.             }
  1870.             for (i = 0, pow = 1; pow <= denominator; pow *= 2, i++);
  1871.             i--;
  1872.             event[(*num_bytes)++] = (unsigned char)i;
  1873.             event[(*num_bytes)++] = (unsigned char)strtol(argv[3],
  1874.                 &chk_ptr, 0);
  1875.             if (chk_ptr == argv[3]) {
  1876.                 Tcl_AppendResult(interp, "Bad numerator: ",
  1877.                     argv[3], (char *)NULL);
  1878.                 return (TCL_ERROR);
  1879.             }
  1880.             event[(*num_bytes)++] = (unsigned char)strtol(argv[4],
  1881.                 &chk_ptr, 0);
  1882.             if (chk_ptr == argv[4]) {
  1883.                 Tcl_AppendResult(interp, "Bad numerator: ",
  1884.                     argv[4], (char *)NULL);
  1885.                 return (TCL_ERROR);
  1886.             }
  1887.         } else
  1888.             bad_meta_event = 1;
  1889.         break;
  1890.     }
  1891.     if (bad_meta_event) {
  1892.         Tcl_AppendResult(interp, "Bad META event: meta", event_name,
  1893.             ".  Must be one of (", meta_events, ")", (char *)NULL);
  1894.         return (TCL_ERROR);
  1895.     }
  1896.     return (TCL_OK);
  1897. }
  1898.  
  1899. static void
  1900. Tclm_AddMetaString(event, num_bytes, str)
  1901.     unsigned char *event;
  1902.     int *num_bytes;
  1903.     char *str;
  1904. {
  1905.     int i;
  1906.     int str_len;
  1907.     int var_len;
  1908.     unsigned char var_bytes[10];
  1909.  
  1910.     str_len = strlen(str);
  1911.     var_len = fix2var(str_len, var_bytes);
  1912.     for (i = 0; i < var_len; i++)
  1913.         event[(*num_bytes)++] = var_bytes[i];
  1914.     for (i = 0; i < str_len; i++)
  1915.         event[(*num_bytes)++] = str[i];
  1916. }
  1917.  
  1918. static int
  1919. Tclm_AddMetaBytes(interp, event, num_bytes, data)
  1920.     Tcl_Interp *interp;
  1921.     unsigned char *event;
  1922.     int *num_bytes;
  1923.     char *data;
  1924. {
  1925.     int i;
  1926.     int result;
  1927.     int num_data_bytes;
  1928.     int var_len;
  1929.     unsigned char data_bytes[MAX_EVENT_SIZE];
  1930.     unsigned char var_bytes[10];
  1931.  
  1932.     if ((result = Tclm_ConvertBytes(interp, data, data_bytes,
  1933.         &num_data_bytes)) != TCL_OK)
  1934.         return (result);
  1935.  
  1936.     var_len = fix2var(num_data_bytes, var_bytes);
  1937.     for (i = 0; i < var_len; i++)
  1938.         event[(*num_bytes)++] = var_bytes[i];
  1939.     for (i = 0; i < num_data_bytes; i++)
  1940.         event[(*num_bytes)++] = data_bytes[i];
  1941.  
  1942.     return (TCL_OK);
  1943. }
  1944.  
  1945. int
  1946. Tclm_MidiRewind(dummy, interp, argc, argv)
  1947.     ClientData dummy;
  1948.     Tcl_Interp *interp;
  1949.     int argc;
  1950.     char **argv;
  1951. {
  1952.     MIDI_FILE *mfile;
  1953.     char *chk_ptr;
  1954.     char **track_list;
  1955.     int i;
  1956.     int num_tracks;
  1957.     int result;
  1958.     int track;
  1959.  
  1960.     /*
  1961.      * argv[0] - midirewind
  1962.      * argv[1] = mfileId
  1963.      * argv[2] = optional track list
  1964.      */
  1965.     if (argc < 2 || argc > 3) {
  1966.         Tcl_AppendResult(interp, "bad # args: should be \"",
  1967.             argv[0], " mfileId ?track list?\"", (char *)NULL);
  1968.         return (TCL_ERROR);
  1969.     }
  1970.  
  1971.     if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
  1972.         return (result);
  1973.  
  1974.     if (argc == 2)
  1975.         for (i = 0; i < mfile->hchunk.num_trks; i++)
  1976.             rewind_track(&(mfile->tchunks[i]));
  1977.     else {
  1978.         if ((result = Tcl_SplitList(interp, argv[2], &num_tracks,
  1979.             &track_list)) != TCL_OK)
  1980.             return (result);
  1981.         for (i = 0; i < num_tracks; i++) {
  1982.             track = (int)strtol(track_list[i], &chk_ptr, 0);
  1983.             if (chk_ptr == track_list[i] || track < 0 ||
  1984.                 track >= mfile->hchunk.num_trks) {
  1985.                 Tcl_AppendResult(interp, "Bad track value ",
  1986.                     track_list[i], (char *)NULL);
  1987.                 free ((char *)track_list);
  1988.                 return (TCL_ERROR);
  1989.             }
  1990.             rewind_track(&(mfile->tchunks[track]));
  1991.         }
  1992.         free((char *)track_list);
  1993.     }
  1994.  
  1995.     return (TCL_OK);
  1996. }
  1997.  
  1998. int
  1999. Tclm_MidiVarToFix(dummy, interp, argc, argv)
  2000.     ClientData dummy;
  2001.     Tcl_Interp *interp;
  2002.     int argc;
  2003.     char **argv;
  2004. {
  2005.     long fix;
  2006.     int delta;
  2007.     int num_bytes;
  2008.     int result;
  2009.     unsigned char bytes[MAX_EVENT_SIZE];
  2010.  
  2011.     /*
  2012.      * argv[0] - midivartofix
  2013.      * argv[1] - midi event
  2014.      */
  2015.     if (argc != 2) {
  2016.         Tcl_AppendResult(interp, "bad # args: should be\"",
  2017.             argv[0], " midi_event\"", (char *)NULL);
  2018.         return (TCL_ERROR);
  2019.     }
  2020.     if ((result = Tclm_ConvertBytes(interp, argv[1], bytes, &num_bytes))
  2021.         != TCL_OK)
  2022.         return (result);
  2023.  
  2024.     fix = var2fix(bytes, &delta);
  2025.     sprintf(interp->result, "%ld", fix);
  2026.     return (TCL_OK);
  2027. }
  2028.  
  2029. int
  2030. Tclm_MidiFixToVar(dummy, interp, argc, argv)
  2031.     ClientData dummy;
  2032.     Tcl_Interp *interp;
  2033.     int argc;
  2034.     char **argv;
  2035. {
  2036.     long fix;
  2037.     char *chk_ptr;
  2038.     int i;
  2039.     int num_bytes;
  2040.     unsigned char bytes[4];
  2041.     char byte_str[10];
  2042.  
  2043.     /*
  2044.      * argv[0] - midifixtovar
  2045.      * argv[1] - fixed length value
  2046.      */
  2047.     if (argc != 2) {
  2048.         Tcl_AppendResult(interp, "bad # args: should be \"",
  2049.             argv[0], " fixval\"", (char *)NULL);
  2050.         return (TCL_ERROR);
  2051.     }
  2052.  
  2053.     fix = strtol(argv[1], &chk_ptr, 0);
  2054.     if (chk_ptr == argv[1]) {
  2055.         Tcl_AppendResult(interp, "Bad fixed length value ", argv[1],
  2056.             (char *)NULL);
  2057.         return (TCL_ERROR);
  2058.     }
  2059.     num_bytes = fix2var(fix, bytes);
  2060.     for (i = 0; i < num_bytes; i++) {
  2061.         sprintf(byte_str, "0x%02x", bytes[i]);
  2062.         Tcl_AppendElement(interp, byte_str, 0);
  2063.     }
  2064.     return (TCL_OK);
  2065. }
  2066.  
  2067. int
  2068. Tclm_MidiTiming(dummy, interp, argc, argv)
  2069.     ClientData dummy;
  2070.     Tcl_Interp *interp;
  2071.     int argc;
  2072.     char **argv;
  2073. {
  2074.     int delta;
  2075.     int i;
  2076.     int num_bytes;
  2077.     int result;
  2078.     unsigned char bytes[MAX_EVENT_SIZE];
  2079.     char str[10];
  2080.  
  2081.     /*
  2082.      * argv[0] - miditiming
  2083.      * argv[1] - event
  2084.      */
  2085.  
  2086.     if ((result = Tclm_ConvertBytes(interp, argv[1], bytes, &num_bytes))
  2087.         != TCL_OK)
  2088.         return (result);
  2089.  
  2090.     (void)var2fix(bytes, &delta);
  2091.  
  2092.     for (i = 0; i < delta; i++) {
  2093.         sprintf(str, "0x%02x", bytes[i]);
  2094.         Tcl_AppendElement(interp, str, 0);
  2095.     }
  2096.     return (TCL_OK);
  2097. }
  2098.  
  2099. int
  2100. Tclm_MidiPlayable(dummy, interp, argc, argv)
  2101.     ClientData dummy;
  2102.     Tcl_Interp *interp;
  2103.     int argc;
  2104.     char **argv;
  2105. {
  2106.  
  2107.     /*
  2108.      * argv[0] - midiplayable
  2109.      */
  2110.     if (argc != 1) {
  2111.         Tcl_AppendResult(interp, "wrong # args: should be\"",
  2112.             argv[0], "\"", (char *)NULL);
  2113.         return (TCL_ERROR);
  2114.     }
  2115.  
  2116. #ifdef MIDIPLAY
  2117.     Tcl_AppendResult(interp, "1", (char *)NULL);
  2118. #else
  2119.     Tcl_AppendResult(interp, "0", (char *)NULL);
  2120. #endif
  2121.     return (TCL_OK);
  2122. }
  2123.  
  2124. int
  2125. Tclm_TclmVersion(dummy, interp, argc, argv)
  2126.     ClientData dummy;
  2127.     Tcl_Interp *interp;
  2128.     int argc;
  2129.     char **argv;
  2130. {
  2131.  
  2132.     /*
  2133.      * argv[0] - tclmversion
  2134.      */
  2135.     if (argc != 1) {
  2136.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  2137.             argv[0], "\"", (char *)NULL);
  2138.         return (TCL_ERROR);
  2139.     }
  2140.     Tcl_AppendResult(interp, TCLM_PATCHLEVEL, (char *)NULL);
  2141.     return (TCL_OK);
  2142. }
  2143.